Attribute VB_Name = "Module1"
Option Explicit

Private Declare Sub InitCommonControls Lib "comctl32.dll" ()

Public objText As New clsGNUGetText

Public cd As New cCommonDialog

Public bmTiles As New cAlphaDibSection
Public bmToolbar As New cAlphaDibSection

Public fntFont() As New CLogFont

Private objLevelNodeFactory() As ILevelNode
Private nLevelNodeFactoryCount As Long

Public Const IValue_Void As Long = 0
Public Const IValue_Integer As Long = 1
Public Const IValue_Rational As Long = 2
Public Const IValue_Real As Long = 3

Public Sub InitLevelNodeFactory()
If nLevelNodeFactoryCount Then Exit Sub
nLevelNodeFactoryCount = 1
ReDim objLevelNodeFactory(nLevelNodeFactoryCount - 1)
End Sub

Public Function CreateLevelNode(ByVal sNodeType As String) As ILevelNode
Dim i As Long
Dim obj As ILevelNode, ret As ILevelNode
For i = 0 To nLevelNodeFactoryCount - 1
 Set obj = objLevelNodeFactory(i)
 If Not obj Is Nothing Then
  Set ret = obj.NewInstanceIfNodeTypeIsSupported(sNodeType)
  If Not ret Is Nothing Then Exit For
 End If
Next i
If ret Is Nothing Then
 'default node implementation
 Set ret = New ILevelNode
End If
ret.NodeType = sNodeType
Set CreateLevelNode = ret
End Function

Public Function DrawTextAccordingToSize(ByVal hdc As Long, ByVal s As String, ByVal Left As Long, ByVal Top As Long, ByVal Width As Long, ByVal Height As Long, ByVal ForeColor As Long) As Long
Static objCache As New Collection
Dim i As Long
Dim w As Long, h As Long
Dim s1 As String, v As Variant
'///
s1 = objText.StringToHex(s) + "," + CStr(Width) + "," + CStr(Height)
On Error Resume Next
Err.Clear
v = objCache.Item(s1)
If Err.Number Then
 For i = UBound(fntFont) To 0 Step -1
  w = Width
  h = 0
  fntFont(i).VBDrawText hdc, s, Left, Top, w, h, DT_CALCRECT Or DT_WORDBREAK
  If i = 0 Then Exit For
  If w <= Width And h <= Height Then Exit For
 Next i
 objCache.Add Array(i, w, h), s1
Else
 i = v(0)
 w = v(1)
 h = v(2)
End If
'///
DrawTextAccordingToSize = fntFont(i).VBDrawText(hdc, s, Left, Top + (Height - h) \ 2, Width, h, DT_CENTER Or DT_NOCLIP Or DT_WORDBREAK, ForeColor, , True)
End Function

'ad-hoc
Public Function ToSuperscript(ByVal s As String) As String
Dim ret As String
Dim i As Long, c As Long
For i = 1 To Len(s)
 c = AscW(Mid(s, i, 1)) And &HFFFF&
 Select Case c
 Case &H20&
 Case &H31& '1
  c = &HB9&
 Case &H32& '2
  c = &HB2&
 Case &H33& '3
  c = &HB3&
 Case &H30&, &H34& To &H39& '0,4-9
  c = &H2040& + c
 Case &H2B& '+
  c = &H207A
 Case &H2D& '-
  c = &H207B
 Case &H3D& '=
  c = &H207C
 Case &H28& '(
  c = &H207D
 Case &H29& ')
  c = &H207E
 Case &H6E& 'n
  c = &H207F
 Case Else
  Exit Function
 End Select
 ret = ret + ChrW(c)
Next i
ToSuperscript = ret
End Function

'ad-hoc
Public Function ToSubscript(ByVal s As String) As String
Dim ret As String
Dim i As Long, c As Long
For i = 1 To Len(s)
 c = AscW(Mid(s, i, 1)) And &HFFFF&
 Select Case c
 Case &H20&
 Case &H30& To &H39& '0-9
  c = &H2050& + c
 Case &H2B& '+
  c = &H208A
 Case &H2D& '-
  c = &H208B
 Case &H3D& '=
  c = &H208C
 Case &H28& '(
  c = &H208D
 Case &H29& ')
  c = &H208E
 Case &H6E& 'n
  c = &H208F '???
 Case Else
  Exit Function
 End Select
 ret = ret + ChrW(c)
Next i
ToSubscript = ret
End Function

Public Sub Main()
InitCommonControls
frmMain.Show
End Sub
